#include <windows.h>
#include <extend.h>

void _pushc( LPSTR );
void _pushcl( LPSTR, WORD );
void VarFree( PCLIPVAR );

extern PCLIPVAR _lbase, _eval, _tos;

//----------------------------------------------------------------------------//

BOOL _ischar( WORD wParam )
{
   return ( _lbase + 1 + wParam )->wType == VT_CHARACTER;
}

//----------------------------------------------------------------------------//

BOOL _isnum( WORD wParam )
{
   return ( _lbase + 1 + wParam )->wType & ( VT_NUMERIC | VT_FLOAT );
}

//----------------------------------------------------------------------------//

LPSTR _parc( WORD wParam, ... )
{
   va_list va;
   WORD wArrayIndex = 0;

   va_start( va, wParam );
   wArrayIndex = va_arg( va, int );
   va_end( va );

   if( wParam != 0xFFFF )
   {
      if( ( _lbase + 1 + wParam )->wType == VT_CHARACTER )
         return _vmLock( ( _lbase + 1 + wParam )->pOVM );
      else
         return "";
   }
   else
   {
      if( _eval->wType == VT_CHARACTER )
         return _vmLock( _eval->pOVM );
      else
         return "";
   }
}

//----------------------------------------------------------------------------//

WORD _parclen( WORD wParam, ... )
{
   va_list va;
   WORD wArrayIndex = 0;

   va_start( va, wParam );
   wArrayIndex = va_arg( va, int );
   va_end( va );

   if( ( _lbase + 1 + wParam )->wType == VT_CHARACTER )
      return ( _lbase + 1 + wParam )->lLen; // Don't use _vmSize() here
   else                                     // as sometimes mem blocks are larger
      return 0;
}

//----------------------------------------------------------------------------//

LPSTR _pard( WORD wParam, ... )
{
   LPSTR nullDate = "00000000";
   va_list va;
   WORD wArrayIndex = 0;

   va_start( va, wParam );
   wArrayIndex = va_arg( va, int );
   va_end( va );

   if( wParam <= _pcount() )
   {
      if( ( _lbase + 1 + wParam )->wType == VT_DATE )
         return ( _lbase + 1 + wParam )->date;
      else
         return nullDate;
   }
   else
      return nullDate;
}

//----------------------------------------------------------------------------//

BOOL _parl( WORD wParam, ... )
{
   va_list va;
   WORD wArrayIndex = 0;

   va_start( va, wParam );
   wArrayIndex = va_arg( va, int );
   va_end( va );

   if( wParam <= _pcount() )
      return ( BOOL ) IF( ( _lbase + 1 + wParam )->bValue, 1, 0 );
   else
      return FALSE;
}

//----------------------------------------------------------------------------//

int _parni( WORD wParam, ... )
{
   va_list va;
   WORD wArrayIndex = 0;

   va_start( va, wParam );
   wArrayIndex = va_arg( va, int );
   va_end( va );

   if( wParam <= _pcount() )
   {
      switch( ( _lbase + 1 + wParam )->wType )
      {
         case VT_NUMERIC:
              return ( int ) ( _lbase + 1 + wParam )->iValue;

         case VT_FLOAT:
              return ( int ) ( _lbase + 1 + wParam )->fValue;

         default:
              return 0;
      }
   }
   else
      return 0;
}

//----------------------------------------------------------------------------//

void _storni( int iValue, WORD wParam, ... )
{
   va_list va;
   WORD wArrayIndex = 0;

   va_start( va, wParam );
   wArrayIndex = va_arg( va, int );
   va_end( va );

   if( wParam <= _pcount() )
   {
      if( ( _lbase + 1 + wParam )->wType == VT_VREF )
      {
         VarFree( _lbase + 1 + wParam );
         ( ( PCLIPVAR ) ( _lbase + 1 + wParam )->pVoid )->wType  = VT_NUMERIC;
         ( ( PCLIPVAR ) ( _lbase + 1 + wParam )->pVoid )->wClass = 0;
         ( ( PCLIPVAR ) ( _lbase + 1 + wParam )->pVoid )->iValue = iValue;
      }
   }
}

//----------------------------------------------------------------------------//

void _stornl( LONG lValue, WORD wParam, ... )
{
   va_list va;
   WORD wArrayIndex = 0;

   va_start( va, wParam );
   wArrayIndex = va_arg( va, int );
   va_end( va );

   if( wParam <= _pcount() )
   {
      if( ( _lbase + 1 + wParam )->wType == VT_VREF )
      {
         VarFree( _lbase + 1 + wParam );
         ( ( PCLIPVAR ) ( _lbase + 1 + wParam )->pVoid )->wType  = VT_FLOAT;
         ( ( PCLIPVAR ) ( _lbase + 1 + wParam )->pVoid )->wClass = 0;
         ( ( PCLIPVAR ) ( _lbase + 1 + wParam )->pVoid )->fValue = lValue;
      }
   }
}

//----------------------------------------------------------------------------//

void _stords( LPSTR szDate, WORD wParam, ... )
{
   va_list va;
   WORD wArrayIndex = 0;

   va_start( va, wParam );
   wArrayIndex = va_arg( va, int );
   va_end( va );

   if( wParam <= _pcount() )
   {
      if( ( _lbase + 1 + wParam )->wType == VT_VREF )
      {
         VarFree( _lbase + 1 + wParam );
         ( ( PCLIPVAR ) ( _lbase + 1 + wParam )->pVoid )->wType  = VT_DATE;
         ( ( PCLIPVAR ) ( _lbase + 1 + wParam )->pVoid )->wClass = 0;
         // ( ( PCLIPVAR ) ( _lbase + 1 + wParam )->pVoid )->fValue = lValue;
      }
   }
}

//----------------------------------------------------------------------------//

void _storc( LPSTR szText, WORD wParam, ... )
{
   POVM pOVM;
   va_list va;
   WORD wArrayIndex = 0;

   va_start( va, wParam );
   wArrayIndex = va_arg( va, int );
   va_end( va );

   if( wParam <= _pcount() )
   {
      if( ( _lbase + 1 + wParam )->wType == VT_VREF )
      {
         VarFree( _lbase + 1 + wParam );
         pOVM = _vmAlloc( _strlen( szText ) + 1 );
         ( ( PCLIPVAR ) ( _lbase + 1 + wParam )->pVoid )->wType  = VT_CHARACTER;
         ( ( PCLIPVAR ) ( _lbase + 1 + wParam )->pVoid )->wClass = 0;
         ( ( PCLIPVAR ) ( _lbase + 1 + wParam )->pVoid )->pOVM   = pOVM;
         _strcpy( _vmLock( pOVM ), szText );
         _vmUnLock( pOVM );
      }
   }
}

//----------------------------------------------------------------------------//

void _storclen( LPSTR szText, WORD wLen, WORD wParam, ... )
{
   POVM pOVM;
   LPSTR szTarget;
   va_list va;
   WORD wArrayIndex = 0;

   va_start( va, wParam );
   wArrayIndex = va_arg( va, int );
   va_end( va );

   if( wParam <= _pcount() )
   {
      if( ( _lbase + 1 + wParam )->wType == VT_VREF )
      {
         VarFree( _lbase + 1 + wParam );
         pOVM = _vmAlloc( wLen + 1 );
         ( ( PCLIPVAR ) ( _lbase + 1 + wParam )->pVoid )->wType  = VT_CHARACTER;
         ( ( PCLIPVAR ) ( _lbase + 1 + wParam )->pVoid )->wClass = 0;
         ( ( PCLIPVAR ) ( _lbase + 1 + wParam )->pVoid )->pOVM   = pOVM;
         _bcopy( szTarget = _vmLock( pOVM ), szText, wLen );
         szTarget[ wLen ] = 0;
         _vmUnLock( pOVM );
      }
   }
}

//----------------------------------------------------------------------------//

long _parnl( WORD wParam, ... )
{
   PCLIPVAR v;
   va_list va;
   WORD wArrayIndex = 0;

   va_start( va, wParam );
   wArrayIndex = va_arg( va, int );
   va_end( va );

   if( wParam <= _pcount() )
   {
      v = _lbase + 1 + wParam;

      switch( v->wType )
      {
         case VT_NUMERIC:
              return ( long ) v->iValue;

         case VT_FLOAT:
              return ( long ) v->fValue;

         case VT_VREF:
              v = ( PCLIPVAR ) v->pVoid;

              if( v->wType == VT_CHARACTER )
                 return ( long ) _vmLock( v->pOVM );
              break;

         default:
              return 0;
      }
   }
   return 0;
}

//----------------------------------------------------------------------------//

void _ret( void )
{
   _eval->wType  = VT_NIL;
   _eval->wClass = 0;
}

//----------------------------------------------------------------------------//

void _reta( LONG lSize )
{
   _Array( _eval, lSize );
}

//----------------------------------------------------------------------------//

void _retc( LPSTR szText )
{
   _pushc( szText );
   _bcopy( ( LPBYTE ) _eval, ( LPBYTE ) ( --_tos ), sizeof( CLIPVAR ) );
}

//----------------------------------------------------------------------------//

void _retclen( LPSTR szText, WORD wLen )
{
   _pushcl( szText, wLen );
   _bcopy( ( LPBYTE ) _eval, ( LPBYTE ) ( --_tos ), sizeof( CLIPVAR ) );
}

//----------------------------------------------------------------------------//

void _retd( LPSTR szDate )
{
   WORD wDateLen = _strlen( szDate );

   _eval->wType  = VT_DATE;
   _eval->wClass = 0;

   _eval->date[ 0 ] = '0';
   _eval->date[ 1 ] = '0';
   _eval->date[ 2 ] = '0';
   _eval->date[ 3 ] = '0';
   _eval->date[ 4 ] = '0';
   _eval->date[ 5 ] = '0';
   _eval->date[ 6 ] = '0';
   _eval->date[ 7 ] = '0';
   _eval->date[ 8 ] = '0';

   if( wDateLen >= 5 )
   {
      _eval->date[ 0 ] = szDate[ 0 ];
      _eval->date[ 1 ] = szDate[ 1 ];
      _eval->date[ 2 ] = szDate[ 3 ];
      _eval->date[ 3 ] = szDate[ 4 ];

      if( wDateLen == 8 )
      {
         _eval->date[ 4 ] = '1';
         _eval->date[ 5 ] = '9';
         _eval->date[ 6 ] = szDate[ 6 ];
         _eval->date[ 7 ] = szDate[ 7 ];
      }

      if( wDateLen == 10 )
      {
         _eval->date[ 4 ] = szDate[ 6 ];
         _eval->date[ 5 ] = szDate[ 7 ];
         _eval->date[ 6 ] = szDate[ 8 ];
         _eval->date[ 7 ] = szDate[ 9 ];
      }
   }
}

//----------------------------------------------------------------------------//

void _retl( BOOL bValue )
{
   _eval->wType  = VT_LOGICAL;
   _eval->wClass = 0;
   _eval->bValue = bValue;
}

//----------------------------------------------------------------------------//

void _retni( int iValue )
{
   _eval->wType  = VT_NUMERIC;
   _eval->wClass = 0;
   _eval->iValue = iValue;
}

//----------------------------------------------------------------------------//

void _retnl( long lValue )
{
   _eval->wType  = VT_FLOAT;
   _eval->wClass = 0;
   _eval->fValue = ( float ) lValue;
}

//----------------------------------------------------------------------------//

void _isaveret( PCLIPVAR pValue )
{
   _bcopy( _eval, pValue, sizeof( CLIPVAR ) );
}

//----------------------------------------------------------------------------//

WORD _pcount( void )
{
   return _lbase->pcount;
}

//----------------------------------------------------------------------------//

PCLIPVAR _param( WORD wLocal, WORD wMask )
{
   WORD wType = ( _lbase + 1 + wLocal )->wType;

   if( ( wType & wMask ) || ( wType == VT_NIL && wMask == 0xFFFF ) )
      return _lbase + 1 + wLocal;
   else
      return 0;
}

//----------------------------------------------------------------------------//
